perm filename DISTY.F4[PIC,LCS] blob sn#632759 filedate 1982-01-09 generic text, type T, neo UTF8
	DIMENSION I(4),II(4),JIN(3,14000)
	COMMON/D/ JD(4000),ID(3,40000)  /JJJJ/JP,KP,XS,YS
	COMMON NMOUT/OUTER/LFT,RT,TOP,BOT
	INTEGER X1,X2,Y1,Y2,LFT,RT,TOP,BOT
	EQUIVALENCE (X1,I(2)),(Y1,I(3)),(X2,II(2)),(Y2,II(3)),(J,I(4))
	1,(JJ,II(4))
	DATA IFIRST/0/
1	FORMAT(' TYPE INPUT NAME  '$)
2	FORMAT(' TYPE OUTPUT NAME  '$)
3	FORMAT(A5)
4	FORMAT(' TYPE FUNC NAME  '$)
6	FORMAT(4I)
81	FORMAT(2I,2F)
66	FORMAT(5X,4I)
80	FORMAT(' X POS, Y POS, X SIZE, Y SIZE '$)
	IF(IFIRST)GO TO 95
C DOESN'T READ DATA FILE AFTER 1ST TIME.
	IFIRST=-1
	TYPE 1
	ACCEPT 3,NMIN
	CALL IFILE(21,NMIN)
	NNN=1
82	READ(21,6,END=94)NN,(JIN(K,NNN),K=1,3)
	NNN=NNN+1
	GO TO 82
94	NNN=NNN-1
95	NN=0
	NX=0
	TOP=-9999
	BOT=-TOP
	LFT=BOT
	RT=TOP
	TYPE 80
	ACCEPT 81,JP,KP,XS,YS
	IF(XS.EQ.0)XS=1
	IF(YS.EQ.0)YS=1
5	CALL SHFT(I,JIN,NX)
7	IF(NX.EQ.NNN)GO TO 100
	CALL SHFT(II,JIN,NX)
99	IF(JJ.EQ.0)GO TO 13
98	CALL NNO(NN)
	I(1)=NN
	ID(1,NN)=X1
	ID(2,NN)=Y1
	ID(3,NN)=J
	GO TO 8
13	M=1
	K=X2-X1 
	KK=K
	IF(K.GE.0)GO TO 10
	M=-1
	KK=-K
10	L=Y2-Y1 
	MM=1
	LL=L
	IF(L.GE.0)GO TO 11
	MM=-1
	LL=-L
11	IF(LL.GT.KK)GO TO 12
	IF(KK.LT.2)GO TO 98
	DO 9 N=X1,X2-M,M
	A=N-X1
	B=K
	NY=Y1+L*A/B+.5
	CALL NNO(NN)
	ID(1,NN)=N
	ID(2,NN)=NY
	ID(3,NN)=J
C	WRITE(22,6)NN,N,NY,J
9	J=0
8	X1=X2
	Y1=Y2
	J=JJ
	GO TO 7
12	IF(LL.LT.2)GO TO 98
	DO 19 N=Y1,Y2-MM,MM
	A=N-Y1
	B=L
	NY=X1+K*A/B+.5
	CALL NNO(NN)
C	TYPE 6,NN,NY,N,J
C	WRITE(22,6)NN,NY,N,J
	ID(1,NN)=NY
	ID(2,NN)=N
	ID(3,NN)=J
19	J=0
	GO TO 8
	COMMON/DL/SIZE /OUTF/NAME,KK,KNT /TTOP/T,TT,TTT,TTTT
1000	FORMAT(' TYPE .PLT NAME '$)
100	CALL NNO(NN)
	DO 96 K=1,3
96	ID(K,NN)=II(K+1)
	ID(3,NN+1)=-1
	CALL DSTO(BOT,TOP)
101	CALL DPY  
	N=0
	TYPE 1000
	ACCEPT 3,NAME
	IF(NAME.EQ.' ')	NAME='PLT'
	CALL PLOT(0,600,-3)
102	N=N+1
	J=ID(3,N)
	IF(J.GT.1)GO TO 102
C SKIP UNNEEDED LINES.
	IF(J)GO TO 104
	IF(J.GT.0)J=3
	IF(J.EQ.0)J=2
	CALL PLOT(ID(1,N),ID(2,N),J)
	GO TO 102
104	CALL PLOT(ID(1,N),ID(2,N),99)
	GO TO 95
103	FORMAT(4I6)
	END